Imports System.ComponentModel
Imports System.Reflection
Imports PostSharp
Imports PostSharp.Extensibility
Imports PostSharp.Laos

Namespace PostSharp.Samples.Binding
    ''' <summary>
    ''' Custom attribute that, when applied on a type (designated <i>target type</i>), implements the interface
    ''' <see cref="INotifyPropertyChanged"/> and raises the <see cref="INotifyPropertyChanged.PropertyChanged"/>
    ''' event when any property of the target type is modified.
    ''' </summary>
    ''' <remarks>
    ''' Event raising is implemented by appending logic to the <b>set</b> accessor of properties. The 
    ''' <see cref="INotifyPropertyChanged.PropertyChanged"/> is raised only when accessors successfully complete and the
    ''' underlying value is really changed.
    ''' </remarks>
    <MulticastAttributeUsage(MulticastTargets.Class Or MulticastTargets.Struct), Serializable()> _
    Public NotInheritable Class SupportDataBindingAttribute
        Inherits CompoundAspect

#Region "Private Variables"
        <NonSerialized()> Private myAspectPriority As Integer = 0
#End Region

        ''' <summary>
        ''' Method called at compile time to get individual aspects required by the current compound
        ''' aspect.
        ''' </summary>
        ''' <param name="targetElement">Metadata element (<see cref="Type"/> in our case) to which
        ''' the current custom attribute instance is applied.</param>
        ''' <param name="collection">Collection of aspects to which individual aspects should be
        ''' added.</param>
        Public Overloads Overrides Sub ProvideAspects(ByVal targetElement As Object, ByVal collection As LaosReflectionAspectCollection)
            ' Get the target type.
            Dim targetType As Type = DirectCast(targetElement, Type)

            ' On the type, add a Composition aspect to implement the INotifyPropertyChanged interface.
            collection.AddAspect(targetType, New AddNotifyPropertyChangedInterfaceSubAspect())
            ' On the type, add a Composition aspect to implement the IEditableObject interface
            collection.AddAspect(targetType, New AddEditableObjectInterfaceSubAspect())

            ' Add a OnMethodBoundaryAspect on each writable non-static property. The implementation of
            ' INotifyPropertyChanged.PropertyChanged needs the name of the property (not of the field), so we have to detect
            ' changes on the property level, not on the field level. Unfortunately, there is no rule for naming properties and
            ' their related fields. Even more, one property could access many fields, or gets its value out of one or
            ' more fields. At this point, using an enhancer to add this functionallity is only recomended, as there exixts a design
            ' rule, which relates one field to one and only one property and vice versa. Unfortunately, there is no compile time check available.
            ' Please be careful!!
            ' Personally, I tend to say, that implementing INotifyPropertyChanged is out of the scope of enhancers due to the 
            ' possibility to pack logic within the properties implementation, which is never under the enhancers control.
            For Each pi As PropertyInfo In targetType.UnderlyingSystemType.GetProperties()
                If pi.DeclaringType Is targetType AndAlso pi.CanWrite Then
                    Dim mi As MethodInfo = pi.GetSetMethod()
                    If Not mi.IsStatic Then
                        collection.AddAspect(mi, New OnPropertySetSubAspect(pi.Name, Me))
                    End If
                End If
            Next

            ' Add a OnFieldAccess aspect on each writable non-static field, used to backup the original values to have a backup copy
            ' for the CancleEdit command of IEditableObject.
            For Each field As FieldInfo In targetType.GetFields(BindingFlags.Instance Or BindingFlags.Public Or BindingFlags.NonPublic)
                If field.DeclaringType Is targetType AndAlso (field.Attributes And FieldAttributes.InitOnly) = 0 Then
                    collection.AddAspect(field, New OnFieldAccessSubAspect())
                End If
            Next
        End Sub

        Public Property AspectPriority() As Integer
            Get
                Return myAspectPriority
            End Get
            Set(ByVal value As Integer)
                myAspectPriority = value
            End Set
        End Property

        ''' <summary>
        ''' Implementation of <see cref="OnMethodBoundaryAspect"/> that raises the 
        ''' <see cref="INotifyPropertyChanged.PropertyChanged"/> event when a property set
        ''' accessor completes successfully and the value really changes.
        ''' </summary>
        <Serializable()> _
        Private Class OnPropertySetSubAspect
            Inherits OnMethodBoundaryAspect

            Private ReadOnly myPropertyName As String
            Private myOldValue As Object

            ''' <summary>
            ''' Initializes a new <see cref="OnPropertySetSubAspect"/>.
            ''' </summary>
            ''' <param name="propertyName">Name of the property to which this set accessor belong.</param>
            ''' <param name="parent">Parent <see cref="NotifyPropertyChangedAttribute"/>.</param>
            Public Sub New(ByVal propertyName As String, ByVal parent As SupportDataBindingAttribute)
                Me.AspectPriority = parent.AspectPriority
                myPropertyName = propertyName
            End Sub

            Public Overrides Sub OnEntry(ByVal eventArgs As MethodExecutionEventArgs)
                With eventArgs
                    ' Construct the name of the properties get-method and backup the value before the set-method is invoked.
                    myOldValue = .Instance.GetType.InvokeMember(.Method.Name.Substring(4), BindingFlags.GetProperty, Nothing, .Instance, Nothing, Nothing, Nothing, Nothing)
                End With
                MyBase.OnEntry(eventArgs)
            End Sub

            ''' <summary>
            ''' Executed when the set accessor successfully completes. Raises the 
            ''' <see cref="INotifyPropertyChanged.PropertyChanged"/> event.
            ''' </summary>
            ''' <param name="eventArgs">Event arguments with information about the 
            ''' current execution context.</param>
            Public Overloads Overrides Sub OnSuccess(ByVal eventArgs As MethodExecutionEventArgs)
                Dim newValue As Object
                With eventArgs
                    newValue = .Instance.GetType.InvokeMember(.Method.Name.Substring(4), BindingFlags.GetProperty, Nothing, .Instance, Nothing, Nothing, Nothing, Nothing)
                End With
                ' Raises the PropertyChanged event, if necessary. We assume in this sample, that only value types were used.
                If myOldValue <> newValue Then
                    ' Get the implementation of INotifyPropertyChanged. We have access to it through the IComposed interface,
                    ' which is implemented at compile time.
                    Dim implementation As NotifyPropertyChangedImplementation = DirectCast((DirectCast(eventArgs.Instance, IComposed(Of INotifyPropertyChanged))).GetImplementation(eventArgs.InstanceCredentials), NotifyPropertyChangedImplementation)
                    implementation.OnPropertyChanged(myPropertyName)
                End If
            End Sub
        End Class

        <Serializable()> _
       Private Class OnFieldAccessSubAspect
            Inherits OnFieldAccessAspect

            Private myFieldName As String
            Private myFieldDefaultValue As Object

            Public Sub New()
                Me.AspectPriority = Integer.MinValue
            End Sub

            ''' <summary>
            ''' Called at compile-time, initializes the current instance with
            ''' values that depends on the fields to which the current sub-aspect is applied.
            ''' We basically remember the field name and its default value.
            ''' </summary>
            ''' <param name="field">Field to which the current sub-aspect is applied.</param>
            Public Overloads Overrides Sub CompileTimeInitialize(ByVal field As FieldInfo)
                MyBase.CompileTimeInitialize(field)
                myFieldName = field.Name
                myFieldDefaultValue = field.GetRawConstantValue()
            End Sub

            ''' <summary>
            ''' Method called at runtime instead of the <b>get field</b> operation.
            ''' </summary>
            ''' <param name="eventArgs">Information about the current execution context.</param>
            Public Overloads Overrides Sub OnGetValue(ByVal eventArgs As FieldAccessEventArgs)
                eventArgs.ExposedFieldValue = eventArgs.StoredFieldValue
            End Sub

            ''' <summary>
            ''' Method called at runtime instead of the <b>set field</b> operation.
            ''' </summary>
            ''' <param name="eventArgs">Information about the current execution context.</param>
            Public Overloads Overrides Sub OnSetValue(ByVal eventArgs As FieldAccessEventArgs)
                ' Get the EditableObjectImplementation object for the  instance.
                Dim impl As EditableObjectImplementation = DirectCast((DirectCast(eventArgs.Instance, IComposed(Of IEditableObject))).GetImplementation(eventArgs.InstanceCredentials), EditableObjectImplementation)

                'Only valid for value types, references needs cascading.
                impl.BackupValue(myFieldName, eventArgs.StoredFieldValue)
                eventArgs.StoredFieldValue = eventArgs.ExposedFieldValue
            End Sub

            ''' <summary>
            ''' Gets weaving options.
            ''' </summary>
            ''' <returns>An option meaning that we want the physical field to be removed (since we replace all fields by a dictionary).</returns>
            Public Overloads Overrides Function GetOptions() As OnFieldAccessAspectOptions
                'Dont remove storage, other enhancer frameworks, like OpenAccess will fail.
                Return OnFieldAccessAspectOptions.None
            End Function
        End Class

        ''' <summary>
        ''' Implementation of <see cref="CompositionAspect"/> that adds the <see cref="INotifyPropertyChanged"/>
        ''' interface to the type to which it is applied.
        ''' </summary>
        <Serializable()> _
        Private Class AddNotifyPropertyChangedInterfaceSubAspect
            Inherits CompositionAspect
            ''' <summary>
            ''' Called at runtime, creates the implementation of the <see cref="INotifyPropertyChanged"/> interface.
            ''' </summary>
            ''' <param name="eventArgs">Execution context.</param>
            ''' <returns>A new instance of <see cref="NotifyPropertyChangedImplementation"/>, which implements
            ''' <see cref="INotifyPropertyChanged"/>.</returns>
            Public Overloads Overrides Function CreateImplementationObject(ByVal eventArgs As InstanceBoundLaosEventArgs) As Object
                Return New NotifyPropertyChangedImplementation(eventArgs.Instance)
            End Function

            ''' <summary>
            ''' Called at compile-time, gets the interface that should be publicly exposed.
            ''' </summary>
            ''' <param name="containerType">Type on which the interface will be implemented.</param>
            ''' <returns></returns>
            Public Overloads Overrides Function GetPublicInterface(ByVal containerType As Type) As Type
                Return GetType(INotifyPropertyChanged)
            End Function

            ''' <summary>
            ''' Gets weaving options.
            ''' </summary>
            ''' <returns>Weaving options specifying that the implementation accessor interface (<see cref="IComposed{T}"/>)
            ''' should be exposed, and that the implementation of interfaces should be silently ignored if they are
            ''' already implemented in the parent types.</returns>
            Public Overloads Overrides Function GetOptions() As CompositionAspectOptions
                Return CompositionAspectOptions.GenerateImplementationAccessor Or CompositionAspectOptions.IgnoreIfAlreadyImplemented
            End Function
        End Class

        ''' <summary>
        ''' Implementation of the <see cref="INotifyPropertyChanged"/> interface.
        ''' </summary>
        Private Class NotifyPropertyChangedImplementation
            Implements INotifyPropertyChanged
            ' Instance that exposes the current implementation.
            Private ReadOnly myInstance As Object

            ''' <summary>
            ''' Initializes a new <see cref="NotifyPropertyChangedImplementation"/> instance.
            ''' </summary>
            ''' <param name="instance">Instance that exposes the current implementation.</param>
            Public Sub New(ByVal instance As Object)
                myInstance = instance
                My.Application.Log.WriteEntry("+++ INotifyPropertyChanged is implemented on " + myInstance.GetType.Name)
            End Sub

            ''' <summary>
            ''' Event raised when a property is changed on the instance that
            ''' exposes the current implementation.
            ''' </summary>
            Private Event PropertyChanged(ByVal sender As Object, ByVal e As System.ComponentModel.PropertyChangedEventArgs) Implements System.ComponentModel.INotifyPropertyChanged.PropertyChanged

            ''' <summary>
            ''' Raises the <see cref="PropertyChanged"/> event. Called by the
            ''' property-level aspect (<see cref="AddNotifyPropertyChangedInterfaceSubAspect"/>)
            ''' at the end of property set accessors.
            ''' </summary>
            ''' <param name="propertyName">Name of the changed property.</param>
            Public Sub OnPropertyChanged(ByVal propertyName As String)
                If String.IsNullOrEmpty(propertyName) Then
                    My.Application.Log.WriteEntry("+++ PropertyChanged event fires for all props.")
                Else
                    My.Application.Log.WriteEntry("+++ PropertyChanged event fires for " + propertyName)
                End If
                RaiseEvent PropertyChanged(myInstance, New PropertyChangedEventArgs(propertyName))
            End Sub
        End Class

        ''' <summary>
        ''' Implementation of <see cref="CompositionAspect"/> that adds the <see cref="IEditableObject"/>
        ''' interface to the type to which it is applied.
        ''' </summary>
        <Serializable()> Private Class AddEditableObjectInterfaceSubAspect
            Inherits CompositionAspect

            ''' <summary>
            ''' Called at runtime, creates the implementation of the <see cref="IEditableObject"/> interface.
            ''' </summary>
            ''' <param name="eventArgs">Execution context.</param>
            ''' <returns>A new instance of <see cref="EditableObjectImplementation"/>, which implements
            ''' <see cref="IEditableObject"/>.</returns>
            Public Overloads Overrides Function CreateImplementationObject(ByVal eventArgs As InstanceBoundLaosEventArgs) As Object
                Return New EditableObjectImplementation(eventArgs.Instance)
            End Function

            ''' <summary>
            ''' Called at compile-time, gets the interface that should be publicly exposed.
            ''' </summary>
            ''' <param name="containerType">Type on which the interface will be implemented.</param>
            ''' <returns></returns>
            Public Overloads Overrides Function GetPublicInterface(ByVal containerType As Type) As Type
                Return GetType(IEditableObject)
            End Function

            ''' <summary>
            ''' Gets weaving options.
            ''' </summary>
            ''' <returns>Weaving options specifying that the implementation accessor interface (<see cref="IComposed{T}"/>)
            ''' should be exposed, and that the implementation of interfaces should be silently ignored if they are
            ''' already implemented in the parent types.</returns>
            Public Overloads Overrides Function GetOptions() As CompositionAspectOptions
                Return CompositionAspectOptions.GenerateImplementationAccessor Or CompositionAspectOptions.IgnoreIfAlreadyImplemented
            End Function
        End Class

        ''' <summary>
        ''' Implementation of the <see cref="IEditableObject"/> interface.
        ''' </summary>
        ''' <remarks>
        ''' This implementation object also contains two dictionaries for the working copy and the backup copy
        ''' of field values.
        ''' </remarks>
        Private Class EditableObjectImplementation
            Implements IEditableObject

            Private ReadOnly myInstance As Object
            Private HasPendingTransaction As Boolean
            Private myBackup As New Dictionary(Of String, Object)
            Private myINotifyPropChangedImpl As NotifyPropertyChangedImplementation

            Private Sub FirePropertyChangedForAll()
                'Cache the implementation object, because its expensive to get the hands on it
                If myINotifyPropChangedImpl Is Nothing Then
                    Dim mixIns As IComposed(Of INotifyPropertyChanged) = DirectCast(myInstance, INotifyPropertyChanged)
                    myINotifyPropChangedImpl = DirectCast(mixIns.GetImplementation(Nothing), NotifyPropertyChangedImplementation)
                End If
                ' Using nothing (null) instead of a property name informs the UI to update all bounded controls of the form.
                If myINotifyPropChangedImpl IsNot Nothing Then myINotifyPropChangedImpl.OnPropertyChanged(Nothing)
            End Sub

            'Called by the OnFieldAccess aspect, if the field value is effectivly changed
            Friend Sub BackupValue(ByVal fieldName As String, ByVal value As Object)
                If HasPendingTransaction AndAlso Not myBackup.ContainsKey(fieldName) Then myBackup(fieldName) = value
            End Sub

            Private Sub RestoreBackup()
                My.Application.Log.WriteEntry("*** Restore Backup")
                With myInstance.GetType
                    For Each elem As KeyValuePair(Of String, Object) In myBackup
                        Dim fi As FieldInfo = .GetField(elem.Key, BindingFlags.NonPublic Or BindingFlags.Public Or BindingFlags.Instance)
                        fi.SetValue(myInstance, elem.Value)
                    Next
                End With
            End Sub

            Private Sub ClearBackup()
                My.Application.Log.WriteEntry("*** Clear Backup")
                myBackup.Clear()
            End Sub

            ''' <summary>
            ''' Initializes a new <see cref="NotifyPropertyChangedImplementation"/> instance.
            ''' </summary>
            ''' <param name="instance">Instance that exposes the current implementation.</param>
            Public Sub New(ByVal instance As Object)
                myInstance = instance
                'For what reason ever, we cant get the implementation of INotifyPropertyChanged here.
                My.Application.Log.WriteEntry("*** IEditableObject is implemented on " + myInstance.GetType.Name)
            End Sub

            ''' <summary>
            ''' Begins editing and backup current field values.
            ''' </summary>
            Private Sub BeginEdit() Implements IEditableObject.BeginEdit
                My.Application.Log.WriteEntry("*** Begin Edit")
                HasPendingTransaction = True
            End Sub

            ''' <summary>
            ''' Cancels editing and rolls back changes.
            ''' </summary>
            Private Sub CancelEdit() Implements IEditableObject.CancelEdit
                My.Application.Log.WriteEntry("*** CancleEdit")
                If HasPendingTransaction Then
                    RestoreBackup()
                    HasPendingTransaction = False
                    FirePropertyChangedForAll()
                    ClearBackup()
                End If
            End Sub

            ''' <summary>
            ''' Ends editing and accept new field values.
            ''' </summary>
            Private Sub EndEdit() Implements IEditableObject.EndEdit
                My.Application.Log.WriteEntry("*** EndEdit")
                If HasPendingTransaction Then
                    ClearBackup()
                    HasPendingTransaction = False
                End If
            End Sub
        End Class

    End Class
End Namespace

